home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / COPYMM2.M < prev    next >
Encoding:
Text File  |  1994-06-09  |  9.9 KB  |  331 lines
  1. MODULE CopyMM2;
  2.  
  3. (*
  4.  * 20.11.90: Kopiert auch, wenn Datum gleich, aber Länge ungleich
  5.  * 07.12.90: Änd. v. 20.11. wieder raus, da sonst schon komprimierte
  6.  *           Dateien erneut kopiert werden.
  7.  * 13.12.90: Tiny-Shell-Dateien M2B/M2P nicht kopiert
  8.  * 25.02.91: kopiert nur Dateien mit gesetzten Archiv-Bit, löscht dann das Bit.
  9.  *)
  10.  
  11. IMPORT GEMDOSIO; (*$E MOS *)
  12.  
  13. FROM InOut IMPORT Write, WriteLn, WriteString, WriteInt, Read, ReadString,
  14.         WritePg, CloseOutput, OpenOutput;
  15.  
  16. FROM Paths IMPORT SearchFile, ListPos;
  17. FROM PathEnv IMPORT HomePath;
  18.  
  19. FROM ShellMsg IMPORT ShellPath, StdPaths;
  20.  
  21. FROM Files IMPORT File, Access, Open, Close, Create, State,
  22.         replaceOld, GetDateTime, SetDateTime;
  23.  
  24. FROM MOSGlobals IMPORT Date, Time, PfxStr, SfxStr;
  25.  
  26. FROM Clock IMPORT PackDate, PackTime;
  27.  
  28. FROM Binary IMPORT FileSize, WriteBytes, ReadBytes;
  29.  
  30. FROM Directory IMPORT MakeFullPath, DirQuery, DirEntry, SetFileAttr,
  31.         GetFileAttr, QueryFiles, QueryAll, FileAttr, FileAttrSet;
  32.  
  33. FROM FileNames IMPORT ValidatePath, FilePrefix, FileSuffix;
  34.  
  35. FROM Strings IMPORT String, StrEqual, Append, Assign, Length, Space, Upper,
  36.         Concat;
  37.  
  38. FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD, ASSEMBLER;
  39.  
  40. VAR protToFile, clearArchivBit, fullCompare, checkOnly, subdirs, ok: BOOLEAN;
  41.     reason: CHAR;
  42.     res: INTEGER;
  43.     fDest, fSrc: File;
  44.     buf, buf2: ARRAY [1..$8000] OF CARDINAL;
  45.  
  46. PROCEDURE error (s, m: ARRAY OF CHAR);
  47.   VAR ch: CHAR;
  48.   BEGIN
  49.     WriteLn;
  50.     WriteString (s);
  51.     Write (' ');
  52.     WriteString (m);
  53.     IF ~protToFile THEN
  54.       Read (ch);
  55.     END
  56.   END error;
  57.  
  58. PROCEDURE checkFile (REF path: ARRAY OF CHAR; entry: DirEntry): BOOLEAN;
  59.  
  60.   PROCEDURE equal (a,b: ADDRESS; n: LONGCARD): BOOLEAN;
  61.     VAR r: BOOLEAN;
  62.     BEGIN
  63.       ASSEMBLER
  64.         MOVE.L  a(A6),A0
  65.         MOVE.L  b(A6),A1
  66.         MOVE.L  n(A6),D0
  67.         MOVEQ   #0,D1
  68.         BRA     l
  69.      l2 SWAP    D0
  70.      l1 CMPM.B  (A0)+,(A1)+
  71.      l  DBNE    D0,l1
  72.         BNE     f
  73.         SWAP    D0
  74.         DBRA    D0,l2
  75.         MOVE.B  -1(A0),D0
  76.         CMP.B   -1(A1),D0
  77.      f  SEQ     D0
  78.         ANDI    #1,D0
  79.         MOVE    D0,r(A6)
  80.       END;
  81.       RETURN r
  82.     END equal;
  83.   
  84.   PROCEDURE filesEqual (f1, f2: File): BOOLEAN;
  85.     VAR n, n1: LONGCARD;
  86.     BEGIN
  87.       n:= SIZE (buf);
  88.       LOOP
  89.         ReadBytes (f1, ADR (buf), n, n1);
  90.         ReadBytes (f2, ADR (buf2), n, n);
  91.         IF n <> n1 THEN
  92.           RETURN FALSE
  93.         ELSIF n=0L THEN
  94.           EXIT
  95.         ELSIF ~equal (ADR (buf), ADR (buf2), n) THEN
  96.           RETURN FALSE
  97.         END
  98.       END;
  99.       RETURN TRUE
  100.     END filesEqual;
  101.  
  102.   VAR dest, src: String;
  103.       pref: PfxStr;
  104.       sfx: SfxStr;
  105.       n: LONGCARD;
  106.       opened, mustcopy: BOOLEAN;
  107.       dat2, date: Date;
  108.       tim2, time: Time;
  109.       attr: FileAttrSet;
  110.  
  111.   BEGIN
  112.     reason:= "?";
  113.     Concat (path, entry.name, dest, ok);
  114.     IF subdirAttr IN entry.attr THEN
  115.       IF entry.name[0] # '.' THEN
  116.         pref:= FilePrefix (entry.name);
  117.         IF StrEqual ('ST_FPU', pref)
  118.         OR StrEqual ('TT_FPU', pref)
  119.         OR StrEqual ('PACKER', pref)
  120.         OR StrEqual ('MAXIDISK', pref)
  121.         OR StrEqual ('ASM68020', pref)
  122.         OR StrEqual ('TEMPLMON', pref) THEN
  123.           (* diese Dateien nicht kopieren *)
  124.           WriteLn;
  125.           WriteString ('*** Ignoring ');
  126.           WriteString (dest);
  127.           WriteString ('\ ***');
  128.           RETURN TRUE
  129.         END;
  130.         Append ('\*.*', dest, ok);
  131.         DirQuery (dest, QueryAll, checkFile, res);
  132.         Close (fDest);
  133.         Close (fSrc);
  134.         IF res < 0 THEN
  135.           error (dest, "Can't access subdir");
  136.         END
  137.       END
  138.     ELSE
  139.       IF StrEqual ('MM2DEF.M2L', entry.name)
  140.       OR StrEqual ('MOS_DEF.TOS', entry.name)
  141.       OR StrEqual ('GEM_DEF.TOS', entry.name)
  142.       OR StrEqual ('MOS.TOS', entry.name)
  143.       OR StrEqual ('UTILITY.TOS', entry.name)
  144.       OR StrEqual ('LIB_SRC.TOS', entry.name)
  145.       OR StrEqual ('MOS_DEF.LZH', entry.name)
  146.       OR StrEqual ('GEM_DEF.LZH', entry.name)
  147.       OR StrEqual ('MOS.LZH', entry.name)
  148.       OR StrEqual ('UTILITY.LZH', entry.name)
  149.       OR StrEqual ('LIB_SRC.LZH', entry.name)
  150.       OR StrEqual ('LIB_SRC.TXT', entry.name)
  151.       OR StrEqual ('LHARC.TTP', entry.name)
  152.       OR StrEqual ('MM2CL1.TOS', entry.name)
  153.       OR StrEqual ('MM2CL2.TOS', entry.name)
  154.       OR StrEqual ('TEXTE.TOS', entry.name)
  155.       OR StrEqual ('TEXTE.LZH', entry.name)
  156.       OR StrEqual ('XREF.TXT', entry.name)
  157.       OR StrEqual ('HD_INST.PRG', entry.name)
  158.       OR StrEqual ('NRSC_ASH.PRG', entry.name)
  159.       OR StrEqual ('NRSC.RSC', entry.name)
  160.       OR StrEqual ('HINWEIS.TXT', entry.name)
  161.       OR StrEqual ('MM2TINYS.M2B', entry.name)
  162.       OR StrEqual ('MM2TINYS.M2P', entry.name)
  163.       OR StrEqual ('MM2SHELL.M2B', entry.name)
  164.       OR StrEqual ('MM2SHELL.M2P', entry.name) THEN
  165.         (* diese Dateien nicht kopieren *)
  166.         WriteLn;
  167.         WriteString ('*** Ignoring ');
  168.         WriteString (dest);
  169.         WriteString (' ***');
  170.         RETURN TRUE
  171.       END;
  172.       SearchFile (entry.name, StdPaths, fromStart, ok, src);
  173.       IF ok THEN
  174.         GetFileAttr (src, attr, res);
  175.         sfx:= FileSuffix (entry.name);
  176.         opened:= FALSE;
  177.         IF fullCompare
  178.         OR StrEqual ('IMP', sfx)
  179.         OR StrEqual ('MOD', sfx) THEN
  180.           Open (fSrc, src, readOnly);
  181.           IF State (fSrc) < 0 THEN error (src, 'Open error'); RETURN TRUE END;
  182.           opened:= TRUE;
  183.           Open (fDest, dest, readOnly);
  184.           IF State (fDest) < 0 THEN error (dest, 'Open error'); RETURN TRUE END;
  185.           GetDateTime (fSrc, date, time);
  186.           GetDateTime (fDest, dat2, tim2);
  187.           mustcopy:= FALSE;
  188.           IF (PackDate (date) # PackDate (dat2))
  189.           OR (PackTime (time) # PackTime (tim2)) THEN
  190.             reason:= "T";
  191.             mustcopy:= TRUE;
  192.           ELSIF (FileSize (fSrc) # FileSize (fDest)) THEN
  193.             reason:= "S";
  194.             mustcopy:= TRUE;
  195.           ELSIF fullCompare & ~filesEqual (fSrc, fDest) THEN
  196.             reason:= "C";
  197.             mustcopy:= TRUE;
  198.           END;
  199.           Close (fDest);
  200.           IF NOT mustcopy THEN Close (fSrc) END;
  201.         ELSE
  202.           mustcopy:= archiveAttr IN attr;
  203.           reason:= "A";
  204.         END;
  205.         IF ~mustcopy THEN
  206.           IF clearArchivBit & (archiveAttr IN attr) THEN
  207.             SetFileAttr (src, attr - FileAttrSet {archiveAttr}, res);
  208.           END
  209.         ELSE
  210.           WriteLn;
  211.           WriteString ('Update ');
  212.           WriteString (dest);
  213.           WriteString (Space (34-INTEGER(Length(dest))));
  214.           WriteString (' from ');
  215.           WriteString (src);
  216.           WriteString (' (');
  217.           Write (reason);
  218.           Write (')');
  219.           IF checkOnly THEN
  220.             IF opened THEN Close (fSrc) END;
  221.           ELSE
  222.             IF ~opened THEN
  223.               Open (fSrc, src, readOnly);
  224.               IF State (fSrc) < 0 THEN error (src, 'Open error'); RETURN TRUE END;
  225.             END;
  226.             GetDateTime (fSrc, date, time);
  227.             Create (fDest, dest, writeOnly, replaceOld);
  228.             LOOP
  229.               ReadBytes (fSrc, ADR (buf), SIZE (buf), n);
  230.               IF n=0L THEN EXIT END;
  231.               WriteBytes (fDest, ADR (buf), n)
  232.             END;
  233.             Close (fDest);
  234.             IF State (fDest) < 0 THEN error (dest, 'Close error'); RETURN TRUE END;
  235.             Open (fDest, dest, writeOnly);
  236.             SetDateTime (fDest, date, time);
  237.             Close (fDest);
  238.             Close (fSrc);
  239.             SetFileAttr (src, attr - FileAttrSet {archiveAttr}, res);
  240.           END
  241.         END
  242.       ELSE
  243.         error (src, 'Not found!');
  244.       END;
  245.     END;
  246.     RETURN TRUE
  247.   END checkFile;
  248.  
  249. PROCEDURE checkRes (): BOOLEAN;
  250.   VAR ch: CHAR;
  251.   BEGIN
  252.     IF res < 0 THEN
  253.       WriteLn;
  254.       WriteString ('Error #');
  255.       WriteInt (res,0);
  256.       WriteLn;
  257.       IF ~protToFile THEN
  258.         Read (ch);
  259.       END;
  260.       RETURN TRUE
  261.     END;
  262.     RETURN FALSE
  263.   END checkRes;
  264.  
  265. PROCEDURE Yes (): BOOLEAN;
  266.   VAR ch: CHAR;
  267.   BEGIN
  268.     REPEAT
  269.       Read (ch);
  270.     UNTIL (CAP(ch) = 'J') OR (CAP(ch) = 'Y') OR (CAP(ch) = 'N');
  271.     RETURN (CAP(ch) # 'N')
  272.   END Yes;
  273.   
  274. VAR     n1: String;
  275.         ch: CHAR;
  276.  
  277. BEGIN
  278.   HomePath:= ShellPath;
  279.   WriteString ('Copy MM2'); WriteLn;
  280.   WriteString ('Updates all files on F:\MASTER\ from same on StdPaths()');
  281.   WriteLn;
  282.   WriteString ('>> Wurde auch der GME neu übersetzt?!');
  283.   WriteLn;
  284.   WriteLn;
  285.   WriteString ('Dateiinhalt vergleichen (sonst nur Archivbit) (J/N)? ');
  286.   fullCompare:= Yes ();
  287.   WriteLn;
  288.   WriteString ('Wirklich kopieren (sonst nur Vergleich) (J/N)? ');
  289.   checkOnly:= NOT Yes ();
  290.   IF fullCompare & checkOnly THEN
  291.     WriteLn;
  292.     WriteString ('Archiv-Bit bei identischen Dateien löschen (J/N)? ');
  293.     clearArchivBit:= Yes ();
  294.   ELSE
  295.     clearArchivBit:= FALSE
  296.   END;
  297.   WriteLn;
  298.   WriteString ('Query J:\ (J/N)? ');
  299.   IF Yes () THEN
  300.     WriteLn;
  301.     WriteString ('Protokollausgabe in Datei (J/N)? ');
  302.     protToFile:= Yes ();
  303.     WriteLn;
  304.     IF protToFile THEN
  305.       OpenOutput ("TXT");
  306.     END;
  307.     DirQuery ('J:\*.*', QueryAll, checkFile, res);
  308.     Close (fDest);
  309.     Close (fSrc);
  310.     IF checkRes () THEN END;
  311.   END;
  312.   WriteLn;
  313.   WriteLn;
  314.   WriteString ('Nicht vergessen:');
  315.   WriteLn;
  316.   WriteLn;
  317.   WriteString ('- ggf. DEF-Files in MM2DEF komprimieren und in Libary packen.'); WriteLn;
  318.   WriteString ('- PRGs komprimieren, Fast-Bits wieder setzen.'); WriteLn;
  319.   WriteString ('- ST_FPU und TT_FPU kopieren.'); WriteLn;
  320.   WriteString ('- Files in SRC\ komprimieren.'); WriteLn;
  321.   WriteString ('- LIB_SRC.TXT updaten.'); WriteLn;
  322.   WriteString ('- Prüfen, ob M2P-Datei noch korrektes Format hat.'); WriteLn;
  323.   IF protToFile THEN
  324.     protToFile:= FALSE;
  325.     CloseOutput ();
  326.   END;
  327.   WriteLn;
  328.   WriteString ('Fertig.');
  329.   Read (ch);
  330. END CopyMM2.
  331.